HyperLib 1997 Winter - Disc 1/HYPERLIB-1997-Winter-CD1.ISO.7z/HYPERLIB-1997-Winter-CD1.ISO/オンラインウェア/PRG/ICProgKit 1.3.sit/ICProgKit1.3/Internet Config Source/ICComponent.p

Text File | 1996-07-14 | 20KB | 630 lines

unit ICComponent;

(* ･･･Start Header･･･ *)

(* File:         ICComponent.p
 * Generated by: 1.0d4
 * For:          IC 1.3
 * On:           Sunday, 14 July 1996, 20:19:55
 *
 * This file is part of the Internet Configuration system and
 * is placed in the public domain for the benefit of all.
 *)

(* ･･･End Header･･･ *)

interface

    uses
        Components;

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;

implementation

    uses
{$ifc undefined THINK_Pascal}
        Types, Files, Memory, Errors, ToolUtils, AppleTalk, Aliases,

        ICTypes, ICKeys,
{$endc}
        ICLinkInSubs, ICLinkIn, ICCAPI, ICComponentSelectors;

    const
        ICdefault_file_name_ID = 1024;                        (* ID of resource in component file *)
        ICdefault_prompt_ID = 1025;                            (* ID of resource in component file *)

    type
        globalsRecord = record
                self: ComponentInstance;
                current_target: ComponentInstance;
                inst: ICRRecord;
            end;
        globalsPtr = ^globalsRecord;
        globalsHandle = ^globalsPtr;

    function GetStringFromResourceFile (globals: globalsHandle; id: integer; var name: Str255): ICError;
        var
            err: ICError;
            junk: ICError;
            refnum: integer;
            strh: StringHandle;
    begin
        err := noErr;
        name := '';
        refnum := OpenComponentResFile(Component(globals^^.self));
        if refnum <= 0 then begin
            err := resNotFound;
        end; (* if *)
        if err = noErr then begin
            strh := GetString(id);
            if strh = nil then begin
                err := resNotFound;
            end
            else begin
                name := strh^^;
            end; (* if *)
            junk := CloseComponentResFile(refnum);
        end; (* if *)
        GetStringFromResourceFile := err;
    end; (* GetStringFromResourceFile *)

(* Component Manager routines *)

    function ICCICanDo (globals: globalsHandle; selector: integer): ComponentResult;
    (* Handle the Component Manager CanDo request.*)
    begin
        case selector of
            kComponentVersionSelect..kComponentOpenSelect, kComponentTargetSelect, {}
            kICC_first_select..kICC_last_select:
                ICCICanDo := 1;
            otherwise
                ICCICanDo := 0;
        end; (* case *)
    end; (* ICCICanDo *)

    function ICCIOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Open request, mostly delayed until ICCStart. *)
        var
            err: ComponentResult;
    begin
        (* create our globals *)
        globals := globalsHandle(NewHandle(sizeof(globalsRecord)));
        err := MemError;

        if err = noErr then begin
            globals^^.self := self;
            globals^^.current_target := self;
            (* tell the Component Manager about them *)
            SetComponentInstanceStorage(self, Handle(globals));
        end; (* if *)

        ICCIOpen := noErr;
    end; (* ICCIOpen *)

    function ICCIClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Close request. *)
        var
            err: ComponentResult;
    begin
        err := noErr;
        if globals <> nil then begin
(* err := ICRStop(globals^^.inst); *)
            DisposeHandle(Handle(globals));
        end; (* if *)
        ICCIClose := err;
    end; (* ICCIClose *)

    function ICCITarget (globals: globalsHandle; new_target: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Target. *)
        var
            err: ComponentResult;
    begin
        globals^^.current_target := new_target;
        ICCITarget := noErr;
    end; (* ICCITarget *)

(* Internet Configuration specific routines *)

    function ICCIStart (globals: globalsHandle; creator: OSType): ICError;
    (* Handle the start request, basically a replacement for the open because we need bonus data (creator). *)
        var
            err: OSErr;
    begin
        err := ICRStart(globals^^.inst, creator);
        if err = noErr then begin
            err := ICCDefaultFileName(globals^^.current_target, globals^^.inst.default_filename);
        end; (* if *)
        if err = noErr then begin
            err := GetStringFromResourceFile(globals, ICdefault_prompt_ID, globals^^.inst.prompt);
        end;
        ICCIStart := err;
    end; (* ICCIStart *)

    function ICCIForceInside (globals: globalsHandle; perm: ICPerm; var force_info: boolean): ICError;
        var
            err: ICError;
            current_perm: icPerm;
    begin
        force_info := false;
        current_perm := globals^^.inst.perm;
        if (current_perm = perm) or ((current_perm = icReadWritePerm) and (perm = icReadOnlyPerm)) then begin
            err := noErr;
        end
        else if current_perm = icNoPerm then begin
            err := ICCBegin(globals^^.current_target, perm);
            force_info := (err = noErr);
        end
        else begin
            err := icPermErr;
        end; (* if *)
        ICCIForceInside := err;
    end; (* ICCIForceInside *)

    function ICCIReleaseInside (globals: globalsHandle; force_info: boolean): ICError;
    begin
        if force_info then begin
            ICCIReleaseInside := ICCEnd(globals^^.current_target);
        end
        else begin
            ICCIReleaseInside := noErr;
        end; (* if *)
    end; (* ICCIReleaseInside *)

    (* The set and get routines are significantly complicated by the fact that the ICR versions can call *)
    (* ICBegin if the calling program hasn't done so already. The problem with this is that override *)
    (* component would not see these calls because the ICR code calls the code directly. The solution *)
    (* is for the component to calls these routines itself (which sends them through the override *)
    (* components. Oh god, this is confusing and it's getting worse as I try to maintain compatibility*)
    (* and putting the cache in is going to be even worse. *)

    function ICCIGetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
        var
            err: ICError;
            err2: ICError;
            force_info: boolean;
    begin
        err := ICCIForceInside(globals, icReadOnlyPerm, force_info);
        if err = noErr then begin
            err := ICRGetPref(globals^^.inst, key, attr, buf, size);
        end; (* if *)
        err2 := ICCIReleaseInside(globals, force_info);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        ICCIGetPref := err;
    end; (* ICCIGetPref *)

    function ICCISetPref (globals: globalsHandle; key: Str255; attr: ICAttr; buf: Ptr; size: longint): ICError;
        var
            err: ICError;
            err2: ICError;
            force_info: boolean;
    begin
        err := ICCIForceInside(globals, icReadWritePerm, force_info);
        if err = noErr then begin
            err := ICRSetPref(globals^^.inst, key, attr, buf, size);
        end; (* if *)
        err2 := ICCIReleaseInside(globals, force_info);
        if err = noErr then begin
            err := err2;
        end; (* if *)
        ICCISetPref := err;
    end; (* ICCISetPref *)

    function ICCIFindPrefHandle (globals: globalsHandle; key: Str255; var attr: ICAttr; prefh: Handle): ICError;
        var
            err: ICError;
            prefsize: longint;
            force_info: boolean;
            err2: ICError;
    begin
        err := noErr;
        if prefh = nil then begin
            err := paramErr;
        end;
        prefsize := 0;
        if err = noErr then begin
            err := ICCIForceInside(globals, icReadOnlyPerm, force_info);
            if err = noErr then begin
                err := ICCGetPref(globals^^.current_target, key, attr, nil, prefsize);
            end;
            if err = noErr then begin
                SetHandleSize(prefh, prefsize);
                err := MemError;
            end; (* if *)
            if err = noErr then begin
                HLock(prefh);
                err := ICCGetPref(globals^^.current_target, key, attr, prefh^, prefsize);
                HUnlock(prefh);
            end; (* if *)
            err2 := ICCIReleaseInside(globals, force_info);
        end; (* if *)
        if err = noErr then begin
            err := err2;
        end; (* if *)
        if (prefh <> nil) and (err <> noErr) then begin
            SetHandleSize(prefh, 0);
        end; (* if *)
        ICCIFindPrefHandle := err;
    end; (* ICCIFindPrefHandle *)

    function ICCIGetPrefHandle (globals: globalsHandle; key: Str255; var attr: ICAttr; var prefh: Handle): ICError;
        var
            err: ICError;
    begin
        prefh := NewHandle(0);
        err := MemError;
        if err = noErr then begin
            err := ICCIFindPrefHandle(globals, key, attr, prefh);
        end;
        if err = icPrefNotFoundErr then begin
            SetHandleSize(prefh, 0);
            attr := 0;
            err := noErr;
        end;
        ICCIGetPrefHandle := err;
    end;

    function ICCISetPrefHandle (globals: globalsHandle; key: Str255; attr: ICAttr; prefh: Handle): ICError;
        var
            s: SignedByte;
            err: ICError;
    begin
        err := noErr;
        if prefh <> nil then begin
            if prefh^ = nil then begin
                err := paramErr;
            end; (* if *)
            if err = noErr then begin
                s := HGetState(prefh);
                HLock(prefh);
                err := ICCSetPref(globals^^.current_target, key, attr, prefh^, GetHandleSize(prefh));
                HSetState(prefh, s);
            end; (* if *)
        end
        else begin
            err := ICCSetPref(globals^^.current_target, key, attr, nil, 0);
        end; (* if *)
        ICCISetPrefHandle := err;
    end; (* ICCISetPrefHandle *)

    function ICCIDefaultFileName (globals: globalsHandle; var name: Str63): ICError;
        var
            err: ICError;
            junk: ICError;
            refnum: integer;
            strh: StringHandle;
            s: Str255;
    begin
        err := GetStringFromResourceFile(globals, ICdefault_file_name_ID, s);
        if err <> noErr then begin
            name := ICdefault_file_name;
        end
        else begin
            name := s;
        end;
        ICCIDefaultFileName := err;
    end; (* ICCIDefaultFileName *)

    function ICCILaunchURL (globals: globalsHandle; hint: Str255; data: Ptr; len: longint; var selStart, selEnd: longint): ICError;
        var
            err: ICError;
            urlh: Handle;
            helper: ICAppSpec;
            scheme: Str255;
            junk_attr: longint;
            size: longint;
    begin
        urlh := NewHandle(0);
        err := MemError;
        if err = noErr then begin
            err := ICCParseURL(globals^^.current_target, hint, data, len, selStart, selEnd, urlh);
        end; (* if *)
        if err = noErr then begin
            err := ICUFindScheme(urlh, scheme);
        end; (* if *)
        if err = noErr then begin
            size := sizeof(helper);
            err := ICCGetPref(globals^^.current_target, concat(kICHelper, scheme), junk_attr, @helper, size);
        end; (* if *)
        if err = noErr then begin
            err := ICULaunchURL(helper.fCreator, urlh);
        end; (* if *)
        if urlh <> nil then begin
            DisposeHandle(urlh);
        end; (* if *)
        ICCILaunchURL := err;
    end; (* ICCILaunchURL *)

    function ICCIMapFilename (globals: globalsHandle; filename: Str255; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            entries: Handle;
            junk_attr: ICAttr;
    begin
        err := noErr;
        if filename = '' then begin
            err := paramErr;
        end; (* if *)
        if err = noErr then begin
            err := ICCGetPrefHandle(globals^^.current_target, kICMapping, junk_attr, entries);
        end; (* if *)
        if err = noErr then begin
            err := ICCMapEntriesFilename(globals^^.current_target, entries, filename, entry);
            DisposeHandle(entries);
        end; (* if *)
        ICCIMapFilename := err;
    end; (* ICCIMapFilename *)

    function ICCIMapTypeCreator (globals: globalsHandle; fType, fCreator: OSType; filename: Str255; var entry: ICMapEntry): ICError;
        var
            err: ICError;
            entries: Handle;
            junk_attr: ICAttr;
    begin
        err := ICCGetPrefHandle(globals^^.current_target, kICMapping, junk_attr, entries);
        if err = noErr then begin
            err := ICCMapEntriesTypeCreator(globals^^.current_target, entries, fType, fCreator, filename, entry);
            DisposeHandle(entries);
        end; (* if *)
        ICCIMapTypeCreator := err;
    end; (* ICCIMapTypeCreator *)

(* ･･･Start ICCI.p･･･ *)

  function ICCIStop(globals : globalsHandle) : ICError;
  begin
    ICCIStop := ICRStop(globals^^.inst);
  end; (* ICCIStop *)

  function ICCIFindConfigFile(globals : globalsHandle; count : integer; folders : ICDirSpecArrayPtr) : ICError;
  begin
    ICCIFindConfigFile := ICRFindConfigFile(globals^^.inst, count, folders);
  end; (* ICCIFindConfigFile *)

  function ICCIFindUserConfigFile(globals : globalsHandle; var where : ICDirSpec) : ICError;
  begin
    ICCIFindUserConfigFile := ICRFindUserConfigFile(globals^^.inst, where);
  end; (* ICCIFindUserConfigFile *)

  function ICCIGeneralFindConfigFile(globals : globalsHandle; search_prefs : Boolean; can_create : Boolean; count : integer; folders : ICDirSpecArrayPtr) : ICError;
  begin
    ICCIGeneralFindConfigFile := ICRGeneralFindConfigFile(globals^^.inst, search_prefs, can_create, count, folders);
  end; (* ICCIGeneralFindConfigFile *)

  function ICCIChooseConfig(globals : globalsHandle) : ICError;
  begin
    ICCIChooseConfig := ICRChooseConfig(globals^^.inst);
  end; (* ICCIChooseConfig *)

  function ICCIChooseNewConfig(globals : globalsHandle) : ICError;
  begin
    ICCIChooseNewConfig := ICRChooseNewConfig(globals^^.inst);
  end; (* ICCIChooseNewConfig *)

  function ICCIGetConfigName(globals : globalsHandle; longname : Boolean; var name : Str255) : ICError;
  begin
    ICCIGetConfigName := ICRGetConfigName(globals^^.inst, longname, name);
  end; (* ICCIGetConfigName *)

  function ICCIGetConfigReference(globals : globalsHandle; ref : ICConfigRefHandle) : ICError;
  begin
    ICCIGetConfigReference := ICRGetConfigReference(globals^^.inst, ref);
  end; (* ICCIGetConfigReference *)

  function ICCISetConfigReference(globals : globalsHandle; ref : ICConfigRefHandle; flags : longint) : ICError;
  begin
    ICCISetConfigReference := ICRSetConfigReference(globals^^.inst, ref, flags);
  end; (* ICCISetConfigReference *)

  function ICCISpecifyConfigFile(globals : globalsHandle; var config : FSSpec) : ICError;
  begin
    ICCISpecifyConfigFile := ICRSpecifyConfigFile(globals^^.inst, config);
  end; (* ICCISpecifyConfigFile *)

  function ICCIGetSeed(globals : globalsHandle; var seed : longint) : ICError;
  begin
    ICCIGetSeed := ICRGetSeed(globals^^.inst, seed);
  end; (* ICCIGetSeed *)

  function ICCIGetPerm(globals : globalsHandle; var perm : ICPerm) : ICError;
  begin
    ICCIGetPerm := ICRGetPerm(globals^^.inst, perm);
  end; (* ICCIGetPerm *)

  function ICCIBegin(globals : globalsHandle; perm : ICPerm) : ICError;
  begin
    ICCIBegin := ICRBegin(globals^^.inst, perm);
  end; (* ICCIBegin *)

  function ICCICountPref(globals : globalsHandle; var count : longint) : ICError;
  begin
    ICCICountPref := ICRCountPref(globals^^.inst, count);
  end; (* ICCICountPref *)

  function ICCIGetIndPref(globals : globalsHandle; n : longint; var key : Str255) : ICError;
  begin
    ICCIGetIndPref := ICRGetIndPref(globals^^.inst, n, key);
  end; (* ICCIGetIndPref *)

  function ICCIDeletePref(globals : globalsHandle; key : Str255) : ICError;
  begin
    ICCIDeletePref := ICRDeletePref(globals^^.inst, key);
  end; (* ICCIDeletePref *)

  function ICCIEnd(globals : globalsHandle) : ICError;
  begin
    ICCIEnd := ICREnd(globals^^.inst);
  end; (* ICCIEnd *)

  function ICCIEditPreferences(globals : globalsHandle; key : Str255) : ICError;
  begin
    ICCIEditPreferences := ICREditPreferences(globals^^.inst, key);
  end; (* ICCIEditPreferences *)

  function ICCIParseURL(globals : globalsHandle; hint : Str255; data : Ptr; len : longint; var selStart : longint; var selEnd : longint; url : Handle) : ICError;
  begin
    ICCIParseURL := ICRParseURL(globals^^.inst, hint, data, len, selStart, selEnd, url);
  end; (* ICCIParseURL *)

  function ICCIMapEntriesFilename(globals : globalsHandle; entries : Handle; filename : Str255; var entry : ICMapEntry) : ICError;
  begin
    ICCIMapEntriesFilename := ICRMapEntriesFilename(globals^^.inst, entries, filename, entry);
  end; (* ICCIMapEntriesFilename *)

  function ICCIMapEntriesTypeCreator(globals : globalsHandle; entries : Handle; fType : OSType; fCreator : OSType; filename : Str255; var entry : ICMapEntry) : ICError;
  begin
    ICCIMapEntriesTypeCreator := ICRMapEntriesTypeCreator(globals^^.inst, entries, fType, fCreator, filename, entry);
  end; (* ICCIMapEntriesTypeCreator *)

  function ICCICountMapEntries(globals : globalsHandle; entries : Handle; var count : longint) : ICError;
  begin
    ICCICountMapEntries := ICRCountMapEntries(globals^^.inst, entries, count);
  end; (* ICCICountMapEntries *)

  function ICCIGetIndMapEntry(globals : globalsHandle; entries : Handle; ndx : longint; var pos : longint; var entry : ICMapEntry) : ICError;
  begin
    ICCIGetIndMapEntry := ICRGetIndMapEntry(globals^^.inst, entries, ndx, pos, entry);
  end; (* ICCIGetIndMapEntry *)

  function ICCIGetMapEntry(globals : globalsHandle; entries : Handle; pos : longint; var entry : ICMapEntry) : ICError;
  begin
    ICCIGetMapEntry := ICRGetMapEntry(globals^^.inst, entries, pos, entry);
  end; (* ICCIGetMapEntry *)

  function ICCISetMapEntry(globals : globalsHandle; entries : Handle; pos : longint; var entry : ICMapEntry) : ICError;
  begin
    ICCISetMapEntry := ICRSetMapEntry(globals^^.inst, entries, pos, entry);
  end; (* ICCISetMapEntry *)

  function ICCIDeleteMapEntry(globals : globalsHandle; entries : Handle; pos : longint) : ICError;
  begin
    ICCIDeleteMapEntry := ICRDeleteMapEntry(globals^^.inst, entries, pos);
  end; (* ICCIDeleteMapEntry *)

  function ICCIAddMapEntry(globals : globalsHandle; entries : Handle; var entry : ICMapEntry) : ICError;
  begin
    ICCIAddMapEntry := ICRAddMapEntry(globals^^.inst, entries, entry);
  end; (* ICCIAddMapEntry *)


(* ･･･End ICCI.p･･･ *)

(* ----- Component Entry Point ----- *)

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
    (* Component entry point.  It's pretty neat IMHO. *)
        var
            proc: ProcPtr;
            s: signedByte;
    begin
        proc := nil;
        case params.what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                Main := internetConfigurationComponentInterfaceVersion + 1;
            kComponentCanDoSelect:
                proc := @ICCICanDo;
            kComponentOpenSelect:
                proc := @ICCIOpen;
            (* Component Manager stuff *)
            kComponentCloseSelect:
                proc := @ICCIClose;
            kComponentTargetSelect:
                proc := @ICCITarget;
            (* this component type stuff *)
(* ･･･Start ICCSel.p2･･･ *)

        kICCStart:
          proc := @ICCIStart;
        kICCStop:
          proc := @ICCIStop;
        kICCFindConfigFile:
          proc := @ICCIFindConfigFile;
        kICCFindUserConfigFile:
          proc := @ICCIFindUserConfigFile;
        kICCGeneralFindConfigFile:
          proc := @ICCIGeneralFindConfigFile;
        kICCChooseConfig:
          proc := @ICCIChooseConfig;
        kICCChooseNewConfig:
          proc := @ICCIChooseNewConfig;
        kICCGetConfigName:
          proc := @ICCIGetConfigName;
        kICCGetConfigReference:
          proc := @ICCIGetConfigReference;
        kICCSetConfigReference:
          proc := @ICCISetConfigReference;
        kICCSpecifyConfigFile:
          proc := @ICCISpecifyConfigFile;
        kICCGetSeed:
          proc := @ICCIGetSeed;
        kICCGetPerm:
          proc := @ICCIGetPerm;
        kICCDefaultFileName:
          proc := @ICCIDefaultFileName;
        kICCBegin:
          proc := @ICCIBegin;
        kICCGetPref:
          proc := @ICCIGetPref;
        kICCSetPref:
          proc := @ICCISetPref;
        kICCFindPrefHandle:
          proc := @ICCIFindPrefHandle;
        kICCGetPrefHandle:
          proc := @ICCIGetPrefHandle;
        kICCSetPrefHandle:
          proc := @ICCISetPrefHandle;
        kICCCountPref:
          proc := @ICCICountPref;
        kICCGetIndPref:
          proc := @ICCIGetIndPref;
        kICCDeletePref:
          proc := @ICCIDeletePref;
        kICCEnd:
          proc := @ICCIEnd;
        kICCEditPreferences:
          proc := @ICCIEditPreferences;
        kICCParseURL:
          proc := @ICCIParseURL;
        kICCLaunchURL:
          proc := @ICCILaunchURL;
        kICCMapFilename:
          proc := @ICCIMapFilename;
        kICCMapTypeCreator:
          proc := @ICCIMapTypeCreator;
        kICCMapEntriesFilename:
          proc := @ICCIMapEntriesFilename;
        kICCMapEntriesTypeCreator:
          proc := @ICCIMapEntriesTypeCreator;
        kICCCountMapEntries:
          proc := @ICCICountMapEntries;
        kICCGetIndMapEntry:
          proc := @ICCIGetIndMapEntry;
        kICCGetMapEntry:
          proc := @ICCIGetMapEntry;
        kICCSetMapEntry:
          proc := @ICCISetMapEntry;
        kICCDeleteMapEntry:
          proc := @ICCIDeleteMapEntry;
        kICCAddMapEntry:
          proc := @ICCIAddMapEntry;

(* ･･･End ICCSel.p2･･･ *)
            otherwise
                Main := badComponentSelector;
        end; (* case *)
        if proc <> nil then begin
            if storage <> nil then begin
                s := HGetState(storage);
                HLock(storage);
            end; (* if *)
            Main := CallComponentFunctionWithStorage(storage, params, proc);
            if (storage <> nil) and (params.what <> kComponentCloseSelect) then begin
                HSetState(storage, s);
            end; (* if *)
        end; (* if *)
    end; (* Main *)

end. (* ICComponent *)